home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / pc / LOGIC Apple II 5.25" Library - DOS Part 3 / DOS065.dsk / FILE CABINET III.bas < prev    next >
BASIC Source File  |  2012-02-16  |  14KB  |  440 lines
  1. 0  POKE 216,0
  2. 1000  PRINT "<CTRL-D>MAXFILES1"
  3. 1010 D$ = "<CTRL-D>": REM CTRL D
  4. 1020  PRINT D$"NOMON,I,O,C"
  5. 1030  TEXT : HOME 
  6. 1040  GOSUB 5180
  7. 1050  CLEAR 
  8. 1060  DIM R$(65),AC(21),K(65),H$(21),RN$(21)
  9. 1070  DIM Z$(21)
  10. 1080 COMMA$ = "NO"
  11. 1090 D$ = "<CTRL-D>": REM CTRL D
  12. 1100 H$(0) = "REC#"
  13. 1110 DB$ = "":F$ = "BASENAME": ONERR  GOTO 2610
  14. 1120  GOSUB 4110
  15. 1130  GOTO 2470
  16. 1140 F$ = "HEADER": ONERR  GOTO 1520
  17. 1150  GOSUB 4110
  18. 1160  FOR I = 1 TO NR:H$(I) = R$(I): NEXT I
  19. 1170 NH = NR:NR = 0:MEM =  FRE(0)
  20. 1180 B =  INT(MEM/(13 *NH))
  21. 1190  DIM N$(B,NH),R(B)
  22. 1200 F$ = "INDEX": ONERR  GOTO 4830
  23. 1210  GOSUB 4110
  24. 1220  GOTO 4810
  25. 1230  REM *** SORT ***
  26. 1240  FOR I = 1 TO NR:R(I) = 0: NEXT I
  27. 1250  FOR I = 1 TO NR: FOR J = 1 TO NR
  28. 1260  ON L GOTO 1270,1290
  29. 1270  IF N$(I,S) =  >N$(J,S)  THEN R(I) = R(I) +1
  30. 1280  GOTO 1300
  31. 1290  IF  VAL(N$(I,S)) =  > VAL(N$(J,S))  THEN R(I) = R(I) +1
  32. 1300  NEXT J: NEXT I
  33. 1310  PRINT "SORTING ";
  34. 1320  FOR I = NR TO 1  STEP  -1: FOR J = NR TO 1  STEP  -1
  35. 1330  IF I < >J  THEN  IF R(I) = R(J)  THEN R(J) = R(J) -1
  36. 1340  NEXT J: NEXT I
  37. 1350  PRINT "SORTING "
  38. 1360 J = 1
  39. 1370  IF R(J) = J  THEN J = J +1: GOTO 1370
  40. 1380  IF J > = NR  THEN 1420
  41. 1390  FOR I = 1 TO NH:Z$(I) = N$(R(J),I):N$(R(J),I) = N$(J,I):N$(J,I) = Z$(I): NEXT I
  42. 1400 Z = R(R(J)):R(R(J)) = R(J):R(J) = Z
  43. 1410  GOTO 1370
  44. 1420  PRINT "<CTRL-G>": PRINT "WANT TO SAVE THE "DB$" FILE": PRINT "SORTED BY "H$(S)" TO DISK ";: INPUT "Y/N) ?";L$: IF L$ = "Y"  THEN F$ = "INDEX": GOSUB 4280
  45. 1430  GOTO 4810
  46. 1440 MF = 1: GOSUB 3880
  47. 1450  INPUT "ENTER # OF FIELD FOR SORT ";S$:S =  VAL(S$): IF S <1  OR S >NH  THEN 1450
  48. 1460  PRINT : PRINT "DO YOU WANT TO SORT:": PRINT 
  49. 1470  PRINT "1 ALPHABETICALLY"
  50. 1480  PRINT "2 NUMERICALLY"
  51. 1490  PRINT 
  52. 1500  INPUT "WHICH ";L$:L =  VAL(L$)
  53. 1510  PRINT : PRINT "SORTING ";: GOTO 1240
  54. 1520  CALL 1013: REM *** CREATE HEADERFILE ***
  55. 1530 NR = 1
  56. 1540  HOME : PRINT "PRESS 'RETURN' TO EXIT TO MENU"
  57. 1550  PRINT 
  58. 1560  PRINT "HEADER FOR COLUMN NUMBER "NR": ";: INPUT "";R$(NR)
  59. 1570  IF R$(NR) = ""  OR NR >20  THEN 1600
  60. 1580 NR = NR +1
  61. 1590  GOTO 1560
  62. 1600 NR = NR -1
  63. 1610  GOSUB 4280: GOTO 1160
  64. 1620  REM ***ENTER RECORDS***
  65. 1630  HOME 
  66. 1640  PRINT "THERE ARE "NR" RECORDS"
  67. 1650  PRINT "IN THE "DB$" FILE"
  68. 1660 NR = NR +1
  69. 1670  PRINT "YOU ARE ENTERING RECORD # "NR
  70. 1680  PRINT 
  71. 1690  FOR I = 1 TO NH
  72. 1700  PRINT H$(I)":";: GOSUB 4720:N$(NR,I) = I$
  73. 1710  NEXT I
  74. 1720  PRINT 
  75. 1730  INPUT "MORE (Y/N) ";L$
  76. 1740  IF L$ = "Y"  THEN 1640
  77. 1750 F$ = "INDEX"
  78. 1760  GOSUB 4280
  79. 1770  GOTO 4810
  80. 1780  REM ***SEARCH/CHANGE***
  81. 1790 L = 0
  82. 1800  HOME 
  83. 1810  PRINT "YOU MAY SEARCH BY ANY OF THE FOLLOWING:"
  84. 1820  PRINT 
  85. 1830  GOSUB 3880
  86. 1840  PRINT : PRINT "OR YOU MAY": PRINT 
  87. 1850  PRINT I" MAKE CHANGES"
  88. 1860  PRINT 
  89. 1870  INPUT "WHICH ";S$:S =  VAL(S$)
  90. 1880  IF S <0  OR S >NH +1  THEN 1870
  91. 1890  IF S = NH +1  THEN 2080
  92. 1900  HOME 
  93. 1910  PRINT "PLEASE ENTER THE "H$(S): PRINT "YOU WANT TO FIND.......<CTRL-J>": INPUT "";Q$
  94. 1920  HOME 
  95. 1930  FOR J = 1 TO NR
  96. 1940 N$(J,0) =  STR$(J)
  97. 1950  IF  LEFT$(N$(J,S), LEN(Q$)) = Q$  THEN  GOSUB 2240
  98. 1960  IF L +NH >20  THEN  GOSUB 2060
  99. 1970  NEXT J
  100. 1980  PRINT "THAT'S ALL OF THEM. ";
  101. 1990  PRINT "NOW YOU MAY:"
  102. 2000  PRINT "1 DO MORE SEARCHES"
  103. 2010  PRINT "2 MAKE CHANGES"
  104. 2020  PRINT "3 RETURN TO THE MAIN MENU"
  105. 2030  INPUT "<CTRL-J>WHICH ";S$:S =  VAL(S$)
  106. 2040  IF S <1  OR S >3  THEN 2030
  107. 2050  ON S GOTO 1800,2080,4810
  108. 2060  IF PF < >0  THEN 2070
  109. 2062  PRINT "PRESS RETURN TO CONTINUE, ESC FOR MENU";
  110. 2064  GET L$
  111. 2065  IF  ASC(L$) = 27  THEN 4810
  112. 2066  IF  ASC(L$) < >13  THEN 2064
  113. 2070 L = 0: HOME : RETURN 
  114. 2080  REM ***CHANGE DATA***
  115. 2090  PRINT "<CTRL-J>ENTER THE NUMBER OF THE RECORD"
  116. 2100  INPUT "YOU WANT TO CHANGE ";J$:J =  VAL(J$)
  117. 2110  HOME : GOSUB 2240
  118. 2120  PRINT "<CTRL-J>ENTER THE NUMBER OF THE FIELD YOU WANT": PRINT "TO CHANGE ";
  119. 2130  INPUT "";S$:S =  VAL(S$)
  120. 2140  IF S <1  OR S >NH  THEN 2130
  121. 2150  PRINT 
  122. 2160  PRINT "FROM "H$(S)": "N$(J,S)
  123. 2170  PRINT 
  124. 2180  PRINT "TO "H$(S)": ";: INPUT "";N$(J,S)
  125. 2190  HOME : GOSUB 2240
  126. 2200  PRINT 
  127. 2210  INPUT "<CTRL-J>MORE CHANGES (Y/N) ";L$
  128. 2220  IF L$ = "Y"  THEN 2080
  129. 2230 F$ = "INDEX": GOSUB 4280: GOTO 4810
  130. 2240  REM ***PRINT A RECORD***
  131. 2250  ON PF GOSUB 5230,5250
  132. 2260  PRINT "  "H$(0)": ";J
  133. 2270  FOR I = 1 TO NH
  134. 2280  PRINT I" "H$(I)": "N$(J,I)
  135. 2290  NEXT I
  136. 2300  PRINT 
  137. 2310 L = L +NH +2
  138. 2320  PRINT D$"PR#0"
  139. 2330  RETURN 
  140. 2340  REM ***DELETE RECORDS***
  141. 2350  HOME 
  142. 2360  INPUT "ENTER RECORD NUMBER YOU WANT DELETED ";DR$:DR =  VAL(DR$)
  143. 2370  IF DR <1  OR DR >NR  THEN 2360
  144. 2380  FOR J = DR TO NR -1
  145. 2390  FOR I = 1 TO NH
  146. 2400 N$(J,I) = N$(J +1,I)
  147. 2410  NEXT I
  148. 2420  NEXT J
  149. 2430  PRINT : PRINT "RECORD NUMBER "DR" DELETED!": PRINT 
  150. 2440  INPUT "MORE (Y/N) ";L$
  151. 2450  IF L$ = "Y"  THEN 2360
  152. 2460 NR = NR -1:F$ = "INDEX": GOSUB 4280: GOTO 4810
  153. 2470  REM *** BASENAMEFILE ROUTINES ***
  154. 2480  HOME 
  155. 2490  PRINT "SELECT FROM:": PRINT 
  156. 2500  FOR J = 1 TO NR: PRINT J" "R$(J): NEXT J: PRINT 
  157. 2510  PRINT J" CREATE A NEW DATA BASE"
  158. 2520  IF J >1  THEN  PRINT J +1" DELETE A DATA BASE"
  159. 2530  PRINT 
  160. 2540  INPUT "WHICH ";S$:S =  VAL(S$)
  161. 2550  IF S = J +1  THEN 2660
  162. 2560  IF S <1  OR S >J  THEN  PRINT  CHR$(7);: VTAB  PEEK(37): CALL  -868: GOTO 2540
  163. 2570 DB$ = R$(S)
  164. 2580  IF S < >J  THEN 1140
  165. 2590  PRINT 
  166. 2600  GOTO 2620
  167. 2610  CALL 1013
  168. 2620  IF J = 0  THEN J = 1
  169. 2630  INPUT "NAME FOR NEW DATA BASE FILE :";R$(J)
  170. 2640 NR = J: GOSUB 4280
  171. 2650 DB$ = R$(J -1): GOTO 1140
  172. 2660  REM     *** DELETE A DATA BASE ***
  173. 2670  PRINT : INPUT "DELETE WHICH : ";S$:S =  VAL(S$)
  174. 2680  IF S <1  OR S >J -1  THEN  PRINT  CHR$(7);: VTAB  PEEK(37) -1: CALL  -868: GOTO 2670
  175. 2690  HOME : VTAB (9): PRINT "READY TO DELETE " CHR$(34);R$(S); CHR$(34);".": PRINT 
  176. 2700  PRINT "ONCE DELETED, THIS DATA CANNOT BE"
  177. 2710  PRINT "RECOVERED.  ARE YOU SURE THAT YOU"
  178. 2720  PRINT "WANT TO DELETE IT? (Y/N) ";: INPUT "";S$
  179. 2730  IF S$ < >"Y"  THEN 2470
  180. 2740  HOME : VTAB 12: HTAB 11: INVERSE : PRINT  CHR$(91);" DELETING DATABASE ]": NORMAL 
  181. 2750  ONERR  GOTO 2830
  182. 2760 DB$ = R$(S)
  183. 2770 F$ = "RPTFMTNAME"
  184. 2780  GOSUB 4110
  185. 2790  PRINT D$;"DELETE"DB$" "F$"FILE"
  186. 2800  FOR I = 1 TO NR
  187. 2810  PRINT D$;"DELETE"DB$" "R$(I)" RPTFMTFILE"
  188. 2820  NEXT I
  189. 2830  CALL 1013: PRINT D$"DELETE"DB$" RPTFMTNAMEFILE"
  190. 2840  PRINT D$"DELETE"DB$" INDEXFILE"
  191. 2850  PRINT D$"DELETE"DB$" HEADERFILE"
  192. 2860 DB$ = ""
  193. 2870 F$ = "BASENAME": GOSUB 4110
  194. 2880  IF NR = 1  THEN  PRINT D$"DELETE BASENAMEFILE": GOTO 1000
  195. 2890  FOR I = S TO NR -1
  196. 2900 R$(I) = R$(I +1)
  197. 2910  NEXT I
  198. 2920 NR = NR -1: GOSUB 4280
  199. 2930  GOTO 2470
  200. 2940  REM ***REPORT***
  201. 2950 T9 = 0
  202. 2960  HOME :E = 0
  203. 2970  FOR I = 0 TO 3 *NH +2:K(I) = 0: NEXT I
  204. 2980  FOR I = 0 TO NH:AC(I) = 0: NEXT I:HC = 0:GT = 0
  205. 2990  ON E GOTO 3150
  206. 3000  GOTO 3940
  207. 3010  PRINT : INPUT "HOW MANY HEADERS ";RH$:RH =  VAL(RH$): IF RH <1  OR RH >NH +1  THEN 3010
  208. 3020  IF E = 0  THEN RN$(NN) = "PRESENT"
  209. 3030  FOR I = 1 TO RH *3  STEP 3
  210. 3040  PRINT "ENTER # OF HEADER YOU WANT IN": PRINT "POSITION #"(I +2)/3" ";: INPUT "";K$:K(I) =  VAL(K$)
  211. 3050  IF K(I) <0  OR K(I) >NH  THEN 3040
  212. 3060  PRINT "ENTER TAB FOR "H$(K(I))" ";: INPUT "";K$:K(I +1) =  VAL(K$)
  213. 3070  IF K(I +1) <0  OR K(I +1) >255  THEN 3060
  214. 3080  PRINT "TOTAL ON "H$(K(I))" (Y/N) ";: INPUT L$
  215. 3090  IF L$ = "Y"  THEN K(I +2) = 1:K(0) = 1
  216. 3100  NEXT I
  217. 3110  IF K(0) < >1  THEN 3150
  218. 3120  INPUT "ENTER TAB FOR TOTAL: ";A$
  219. 3130  IF  LEN(A$) = 0  THEN K(0) = 0:T9 = 1: GOTO 3150
  220. 3140 K(I +1) =  VAL(A$): IF K(I +1) <0  OR K(I +1) >131  THEN  PRINT "<CTRL-G>": VTAB  PEEK(37) -1: GOTO 3120
  221. 3150  PRINT 
  222. 3160  INPUT "SELECT RECORDS BY WHICH HEADER # ";S$:S =  VAL(S$)
  223. 3170  IF  LEN(S$) = 0  THEN Q$ = "@": GOTO 3230
  224. 3180  PRINT : INPUT "'AND' 2ND HEADER (Y/N) ";L$: IF L$ < >"Y"  THEN X$ = "@": GOTO 3200
  225. 3190  PRINT : INPUT "ENTER # OF 'AND' HEADER ";X$:X =  VAL(X$)
  226. 3200  PRINT : PRINT "@ WILL SELECT ALL RECORDS."
  227. 3210  PRINT : PRINT "SELECT RECORDS FOR "H$(S)"= ";: INPUT "";Q$: PRINT 
  228. 3220  IF L$ = "Y"  THEN  PRINT "AND "H$(X)"= ";: INPUT "";X$
  229. 3230  FOR I = 1 TO RH +1: IF K(3 *I -1) >35  THEN PF = 2
  230. 3240  NEXT I
  231. 3250  ON PF GOSUB 5230,5250,5280: GOSUB 3610
  232. 3260  FOR J = 1 TO NR
  233. 3270 N$(J,0) =  STR$(J)
  234. 3280  IF Q$ = "@"  THEN 3320
  235. 3290  IF  LEFT$(N$(J,S), LEN(Q$)) < >Q$  THEN 3330
  236. 3300  IF X$ = "@"  THEN 3320
  237. 3310  IF  LEFT$(N$(J,X), LEN(X$)) < >X$  THEN 3330
  238. 3320  GOSUB 3440
  239. 3330  IF PF <1  THEN  IF L >18  THEN  GOSUB 2060: GOSUB 3610
  240. 3340  IF L = 0  THEN  GOSUB 3610
  241. 3350  NEXT J
  242. 3360  ON T9 GOSUB 3540
  243. 3370  PRINT D$"PR#0"
  244. 3380  ON E GOTO 3410
  245. 3390  PRINT : PRINT "DO YOU WANT TO SAVE THE FORMAT": INPUT "FOR THIS REPORT TO DISK (Y/N) ";L$
  246. 3400  IF L$ = "Y"  THEN E = 1: GOSUB 3720
  247. 3410  PRINT : PRINT "MORE REPORTS USING THE "RN$(NN)" FORMAT": INPUT "(Y/N) ";L$
  248. 3420  IF L$ = "Y"  THEN  GOSUB 3880:E = 1: GOTO 2980
  249. 3430  GOTO 4810
  250. 3440  FOR I = 1 TO RH
  251. 3450  POKE 36,K(3 *I -1): PRINT N$(J,K(3 *I -2));
  252. 3460  ON K(3 *I) GOSUB 3510
  253. 3470  NEXT I
  254. 3480  IF K(0) = 1  THEN  IF HC < >0  THEN  POKE 36,K(3 *I -1): PRINT HC;:GT = GT +HC:HC = 0
  255. 3490 L = L +1
  256. 3500  PRINT : RETURN 
  257. 3510 N = 3 *I -2
  258. 3520 V =  VAL(N$(J,K(N))):AC(I) = AC(I) +V:HC = HC +V
  259. 3530  RETURN 
  260. 3540  FOR I = 1 TO 39 +((PF >1) *39): PRINT "-";: NEXT I: PRINT 
  261. 3550  FOR I = 1 TO RH
  262. 3560  IF AC(I) = 0  THEN 3580
  263. 3570  POKE 36,K(3 *I -1): PRINT AC(I);
  264. 3580  NEXT I
  265. 3590  IF GT < >0  THEN  POKE 36,K(3 *I -1): PRINT GT;
  266. 3600  PRINT : RETURN 
  267. 3610  HOME 
  268. 3620  PRINT RN$(NN)" REPORT FOR "H$(S)":"Q$;
  269. 3630  IF X$ = "@"  THEN 3650
  270. 3640  PRINT " AND "H$(X)":"X$: GOTO 3660
  271. 3650  PRINT "<CTRL-J>"
  272. 3660  FOR I = 1 TO RH
  273. 3670  POKE 36,K(3 *I -1): PRINT H$(K(3 *I -2));
  274. 3680  NEXT I
  275. 3690  IF K(0) = 1  THEN  POKE 36,K(3 *I -1): PRINT "TOTAL";
  276. 3700  PRINT : PRINT 
  277. 3710 L = 4: RETURN 
  278. 3720  REM *** SET-UP TO SAVE RPTFMTFILE ***
  279. 3730 NS = NR
  280. 3740  PRINT : INPUT "ENTER THE REPORT FORMAT NAME ";RN$(NN)
  281. 3750 F$ = RN$(NN) +" RPTFMT"
  282. 3760 NR = 3 *RH +2
  283. 3770  FOR I = 1 TO NR:R$(I) =  STR$(K(I)): NEXT I
  284. 3780 R$(I -2) =  STR$(K(0))
  285. 3790  GOSUB 4280: GOSUB 4440
  286. 3800  RETURN 
  287. 3810  REM *** SET-UP TO READ RPTFMTFILE ***
  288. 3820 F$ = RN$(NN) +" RPTFMT"
  289. 3830  GOSUB 4110
  290. 3840 RH = (NR -2)/3: FOR I = 1 TO NR:K(I) =  VAL(R$(I)): NEXT I
  291. 3850 K(0) =  VAL(R$(I -2))
  292. 3860 NR = NS
  293. 3870  GOSUB 3880: PRINT : GOTO 3160
  294. 3880  REM *** SUB MENU ***
  295. 3890  HOME : PRINT "SELECT FROM:": PRINT 
  296. 3900  IF MF = 0  THEN  PRINT "0 "H$(0)
  297. 3910  FOR I = 1 TO NH: PRINT I" "H$(I): NEXT I: PRINT 
  298. 3920 MF = 0
  299. 3930  RETURN 
  300. 3940  REM *** READ REPORTNAMEFILE & SELECT REPORT ***
  301. 3950 NN = 0: FOR I = 0 TO 21:RN$(I) = "": NEXT I:NS = NR
  302. 3960 F$ = "RPTFMTNAME"
  303. 3970  ONERR  GOTO 4070
  304. 3980  GOSUB 4110
  305. 3990  FOR I = 1 TO NR:RN$(I) = R$(I): NEXT I
  306. 4000  HOME : PRINT "SELECT FROM:": PRINT 
  307. 4010  FOR I = 1 TO NR: PRINT I" "R$(I): NEXT I: PRINT 
  308. 4020  PRINT I" CREATE A NEW REPORT FORMAT": PRINT 
  309. 4030  INPUT "WHICH ";S$:S =  VAL(S$): IF S <1  OR S >I  THEN 4030
  310. 4040 NN = S
  311. 4050  IF S < >I  THEN RN$(S) = R$(S):E = 1:NR = NS: GOTO 3810
  312. 4060  GOTO 4100
  313. 4070  CALL 1013: HOME : PRINT "NO REPORT FORMATS ON DISK...": PRINT 
  314. 4080 NN = 1
  315. 4090  INPUT "DO YOU WANT TO CREATE ONE (Y/N) ?";L$: IF L$ < >"Y"  THEN 4810
  316. 4100  GOSUB 3880:NR = NS: GOTO 3010
  317. 4110  REM *** READ FILES ***
  318. 4120  IF F$ < >"INDEX"  THEN FF = 1
  319. 4130  PRINT D$"OPEN"DB$" "F$"FILE"
  320. 4140  PRINT D$"READ"DB$" "F$"FILE"
  321. 4150  INPUT NR
  322. 4160  FOR J = 1 TO NR
  323. 4170  ON FF GOTO 4230
  324. 4180  FOR I = 1 TO NH
  325. 4190  GOSUB 4720
  326. 4200 N$(J,I) = I$
  327. 4210  NEXT I
  328. 4220  GOTO 4240
  329. 4230  INPUT R$(J)
  330. 4240  NEXT J
  331. 4250  PRINT D$"CLOSE"
  332. 4260 FF = 0
  333. 4270  RETURN 
  334. 4280  REM *** SAVE FILES ***
  335. 4290  IF F$ < >"INDEX"  THEN FF = 1
  336. 4300  PRINT D$"OPEN"DB$" "F$"FILE"
  337. 4310  PRINT D$"WRITE"DB$" "F$"FILE"
  338. 4320  PRINT NR
  339. 4330  FOR J = 1 TO NR
  340. 4340  ON FF GOTO 4390
  341. 4350  FOR I = 1 TO NH
  342. 4360  PRINT N$(J,I)
  343. 4370  NEXT I
  344. 4380  GOTO 4400
  345. 4390  PRINT R$(J)
  346. 4400  NEXT J
  347. 4410  PRINT D$"CLOSE"
  348. 4420 FF = 0
  349. 4430  RETURN 
  350. 4440  REM *** SAVE REPORTNAMEFILE ***
  351. 4450 NR = NN
  352. 4460 F$ = "RPTFMTNAME"
  353. 4470  FOR I = 1 TO NR:R$(I) = RN$(I): NEXT I
  354. 4480  GOSUB 4280
  355. 4490 NR = NS: RETURN 
  356. 4500  REM  *** LIST ***
  357. 4510 L = 0
  358. 4520  HOME 
  359. 4530  FOR J = 1 TO NR
  360. 4540  ON PF GOSUB 5230,5250,5280
  361. 4550  PRINT "  "H$(0)": ";J:L = L +1
  362. 4560  FOR I = 1 TO NH
  363. 4570  PRINT I" "H$(I)": "N$(J,I)
  364. 4580 L = L +1
  365. 4590  NEXT I
  366. 4600  PRINT :L = L +1
  367. 4610  IF L +NH >20  THEN 4660
  368. 4620  NEXT J
  369. 4630  PRINT D$"PR#0"
  370. 4640  INPUT "HIT RETURN FOR MENU...";L$
  371. 4650  GOTO 4810
  372. 4660  PRINT D$"PR#0"
  373. 4670  PRINT "PRESS RETURN TO CONTINUE, ESC FOR MENU";
  374. 4672  GET L$
  375. 4674  IF  ASC(L$) = 27  THEN 4810
  376. 4676  IF  ASC(L$) = 13  THEN 4680
  377. 4678  GOTO 4672
  378. 4680  HOME :L = 0
  379. 4690  ON PF GOSUB 5230,5250,5280
  380. 4700  GOTO 4620
  381. 4710  STOP 
  382. 4720  REM   ***  INPUT ROUTINES  ***
  383. 4730 I$ = ""
  384. 4740  IF COMMA$ = "NO"  THEN  INPUT "";I$: RETURN 
  385. 4750  GET A$
  386. 4760  IF A$ =  CHR$(3)  THEN  STOP 
  387. 4770  PRINT A$;
  388. 4780  IF A$ =  CHR$(13)  THEN  RETURN 
  389. 4790 I$ = I$ +A$
  390. 4800  GOTO 4750
  391. 4810  REM *** MAIN MENU ***
  392. 4820  GOTO 4840
  393. 4830  CALL 1013
  394. 4840  HOME 
  395. 4850  PRINT "******* DATA BASE MANAGEMENT I *******"
  396. 4860  PRINT : PRINT "          APPLE COMPUTER INC"
  397. 4870  PRINT 
  398. 4880  PRINT "CURRENT DATA BASE: "DB$: PRINT 
  399. 4890  PRINT "CURRENTLY CONTAINS: "NR" RECORDS": PRINT : PRINT "ROOM FOR "B -NR" MORE RECORDS"
  400. 4900  PRINT 
  401. 4910  IF PF > = 1  THEN  PRINT "THE PRINTER IS ";: FLASH : PRINT "ON": NORMAL : GOTO 4930
  402. 4920  PRINT "THE PRINTER IS OFF"
  403. 4930  PRINT 
  404. 4940  PRINT "1  SELECT DATA BASE"
  405. 4950  PRINT "2  SEARCH AND/OR CHANGE DATA"
  406. 4960  PRINT "3  ENTER RECORDS"
  407. 4970  PRINT "4  DELETE RECORDS"
  408. 4980  PRINT "5  REPORT"
  409. 4990  PRINT "6  SORT (TAKES APPROX. " INT(.0005 *NR ^2 +.03 *NR)" MIN.)"
  410. 5000  PRINT "7  TURN ON PRINTER"
  411. 5010  PRINT "8  TURN OFF PRINTER"
  412. 5020  PRINT "9  LIST ALL RECORDS"
  413. 5030  PRINT "10 QUIT"
  414. 5040  PRINT 
  415. 5050  INPUT "WHICH ";S$:S =  VAL(S$)
  416. 5060  IF S <1  OR S >10  THEN 4810
  417. 5070  ON S GOTO 1050,1780,1620,2340,2940,1440,5080,5160,4500,5170
  418. 5080  HOME 
  419. 5090  PRINT "PRINTER OPTIONS:"
  420. 5100  PRINT "1 40 COLUMNS"
  421. 5110  PRINT "2 80 COLUMNS"
  422. 5120  PRINT "3 132 COLUMNS"
  423. 5130  PRINT : INPUT "WHICH ";PF$:PF =  VAL(PF$)
  424. 5140  IF PF <1  OR PF >3  THEN 5130
  425. 5150  GOTO 4810
  426. 5160 PF = 0: GOTO 4810
  427. 5170  END 
  428. 5180  REM *** APPLESOFT ONERR CORRECTION
  429. 5190  FOR I = 1013 TO 1022: READ PP: POKE I,PP: NEXT I
  430. 5200 I = 0
  431. 5210  RETURN 
  432. 5220  DATA 104,168,104,166,223,154,72,152,72,96
  433. 5230  PRINT D$"PR#1"
  434. 5240  PRINT "<CTRL-I>K<CTRL-^>": RETURN 
  435. 5250  PRINT D$"PR#1"
  436. 5260  PRINT "<CTRL-I>K<CTRL-I>80N<CTRL-]>"
  437. 5270  RETURN 
  438. 5280  PRINT D$"PR#1"
  439. 5290  PRINT "<CTRL-I>K132N"
  440. 5300  RETURN